Celem projektu jest określenie jakie mogą być główne przyczyny stopniowego zmniejszania się długości śledzi oceanicznych wyławianych w Europie.
Zbiór danych zostanie wczytany z pliku CSV, następnie musi zostać poddany wstępnemu oczyszczaniu. # Opis zbioru danych Analiza dotyczy zbióru danych na temat połowu śledzia oceanicznego w Europie. Do analizy zebrano pomiary śledzi i warunków w jakich żyją z ostatnich 60 lat. Dane były pobierane z połowów komercyjnych jednostek. W ramach połowu jednej jednostki losowo wybierano od 50 do 100 sztuk trzyletnich śledzi.
Poniżej znajdują się szczegółowe opisy konkretnych atrybutów:
| Nazwa kolumny | Opis | Dodatkowa Informacja |
|---|---|---|
| length | długość złowionego śledzia | [cm] |
| cfin1 | dostępność planktonu | [zagęszczenie Calanus finmarchicus gat. 1] |
| cfin2 | dostępność planktonu | [zagęszczenie Calanus finmarchicus gat. 2] |
| chel1 | dostępność planktonu | [zagęszczenie Calanus helgolandicus gat. 1] |
| chel2 | dostępność planktonu | [zagęszczenie Calanus helgolandicus gat. 2] |
| lcop1 | dostępność planktonu | [zagęszczenie widłonogów gat. 1] |
| lcop2 | dostępność planktonu | [zagęszczenie widłonogów gat. 2] |
| fbar | natężenie połowów w regionie | [ułamek pozostawionego narybku] |
| recr | roczny narybek | [liczba śledzi] |
| cumf | łączne roczne natężenie połowów w regionie | [ułamek pozostawionego narybku] |
| totaln | łączna liczba ryb złowionych w ramach połowu | [liczba śledzi] |
| sst | temperatura przy powierzchni wody | [°C] |
| sal | poziom zasolenia wody | [Knudsen ppt] |
| xmonth | miesiąc połowu | [numer miesiąca] |
| nao | oscylacja północnoatlantycka | [mb] |
library(knitr)
library(ggplot2)
library(polycor)
library(heatmaply)
library(tidyr)
library(plotly)
library(VIM)
library(caret)
library(klaR)
library(dplyr)
set.seed(23)
raw_data <- read.csv(file= "sledzie.csv", header= TRUE, sep= ",", na.strings= "?")
str(raw_data)
## 'data.frame': 52582 obs. of 16 variables:
## $ X : int 0 1 2 3 4 5 6 7 8 9 ...
## $ length: num 23 22.5 25 25.5 24 22 24 23.5 22.5 22.5 ...
## $ cfin1 : num 0.0278 0.0278 0.0278 0.0278 0.0278 ...
## $ cfin2 : num 0.278 0.278 0.278 0.278 0.278 ...
## $ chel1 : num 2.47 2.47 2.47 2.47 2.47 ...
## $ chel2 : num NA 21.4 21.4 21.4 21.4 ...
## $ lcop1 : num 2.55 2.55 2.55 2.55 2.55 ...
## $ lcop2 : num 26.4 26.4 26.4 26.4 26.4 ...
## $ fbar : num 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
## $ recr : int 482831 482831 482831 482831 482831 482831 482831 482831 482831 482831 ...
## $ cumf : num 0.306 0.306 0.306 0.306 0.306 ...
## $ totaln: num 267381 267381 267381 267381 267381 ...
## $ sst : num 14.3 14.3 14.3 14.3 14.3 ...
## $ sal : num 35.5 35.5 35.5 35.5 35.5 ...
## $ xmonth: int 7 7 7 7 7 7 7 7 7 7 ...
## $ nao : num 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...
Zbiór zawiera 52582 rekordów rozmieszczonych w 16 kolumnach (z czego jedna jest kolumną porządkową).
Zmienna xmonth, która reprezentuje miesiąc połowu powinna zostać zamieniona z ciągłej na kategoryczną, by nie traktować jej jako liczbę. Zmienna totaln, która reprezentuje łączną liczbę ryb złowionych, powinna zostać zmieniona na całkowitą.
raw_data <- raw_data %>%
mutate(xmonth= as.factor(xmonth), totaln= round(totaln), totaln= as.integer(totaln))
#Puste dane liczbowo na kolumnę
apply(raw_data, 2, function(x){ sum(is.na(x)) })
## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr
## 0 0 1581 1536 1555 1556 1653 1591 0 0
## cumf totaln sst sal xmonth nao
## 0 0 1584 0 0 0
#Puste dane procentowo na kolumnę
apply(raw_data, 2, function(x){ sum(is.na(x)) / length(x) })
## X length cfin1 cfin2 chel1 chel2
## 0.00000000 0.00000000 0.03006732 0.02921152 0.02957286 0.02959188
## lcop1 lcop2 fbar recr cumf totaln
## 0.03143661 0.03025750 0.00000000 0.00000000 0.00000000 0.00000000
## sst sal xmonth nao
## 0.03012438 0.00000000 0.00000000 0.00000000
Zbiór zawiera również wartości puste - te pojawiają się głównie w kolumnach z informacją o dostępności planktonu oraz temperaturze przy powierzchni wody.
aggr(raw_data, plot= TRUE,
col= c('#fa9fb5', '#2b8cbe'),
numbers= TRUE,
prop= FALSE,
bars= FALSE,
labels= names(raw_data),
cex.axis= 0.8,
ylab=c("Histogram brakujących danych","Wzorzec"))
Jak zobrazowano na wykresie powyżej, rozkład wartości pustych w kolumnach:
Usuwając wiersze z wartością NA, utracilibyśby stosunkowo dużo danych - lepszym pomysłem jest zastąpienie wartości brakującej średnią z konkretnego połowu. Bazując na fakcie, iż kolumny totaln, xmonth, nao definiują konkretny połów oraz nie zawierają one żadnych wartości pustych, posłużą one do grupowania. Dane zostały zgrupowane względem połowów, a następnie wartości puste zostały zamienione na średnią z tych połowów.
data <- raw_data %>%
group_by(totaln, xmonth, nao) %>%
mutate_each(funs(replace(., which(is.na(.)),
mean(., na.rm=TRUE))))
no_x <- data %>% select(-X)
sum(duplicated(no_x))
## [1] 45694
Możemy zaobserwować, iż 45694 rekordów to duplikaty. Pojawiają się one wewnątrz jednego połowu, dlatego usunięcie ich nie wpłynie negatywnie, ani nie sfałszuje danych. Dla uproszczenia grafów oraz dalszych obliczeń, wszystkie duplikaty zostały usunięte, tym samym zbiór danych uszczuplił się do 6888 rekordów.
w_duplicates <- unique(no_x[, 1:15])
w_duplicates <- w_duplicates %>%
mutate(X = seq_len(n())) %>%
select(X, everything())
str(w_duplicates)
## Classes 'grouped_df', 'tbl_df', 'tbl' and 'data.frame': 6888 obs. of 16 variables:
## $ X : int 1 2 3 4 5 6 7 1 2 3 ...
## $ length: num 23 22.5 25 25.5 24 22 23.5 22.5 22 24.5 ...
## $ cfin1 : num 0.0278 0.0278 0.0278 0.0278 0.0278 ...
## $ cfin2 : num 0.278 0.278 0.278 0.278 0.278 ...
## $ chel1 : num 2.47 2.47 2.47 2.47 2.47 ...
## $ chel2 : num 21.4 21.4 21.4 21.4 21.4 ...
## $ lcop1 : num 2.55 2.55 2.55 2.55 2.55 ...
## $ lcop2 : num 26.4 26.4 26.4 26.4 26.4 ...
## $ fbar : num 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
## $ recr : num 482831 482831 482831 482831 482831 ...
## $ cumf : num 0.306 0.306 0.306 0.306 0.306 ...
## $ totaln: int 267381 267381 267381 267381 267381 267381 267381 267381 267381 267381 ...
## $ sst : num 14.3 14.3 14.3 14.3 14.3 ...
## $ sal : num 35.5 35.5 35.5 35.5 35.5 ...
## $ xmonth: Factor w/ 12 levels "1","2","3","4",..: 7 7 7 7 7 7 7 6 6 6 ...
## $ nao : num 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...
## - attr(*, "vars")=List of 3
## ..$ : symbol totaln
## ..$ : symbol xmonth
## ..$ : symbol nao
## - attr(*, "labels")='data.frame': 551 obs. of 3 variables:
## ..$ totaln: int 144137 144137 144137 144137 144137 144137 144137 144137 144137 147332 ...
## ..$ xmonth: Factor w/ 12 levels "1","2","3","4",..: 2 3 4 5 6 7 8 9 10 2 ...
## ..$ nao : num 0.17 0.17 0.17 0.17 0.17 0.17 0.17 0.17 0.17 2.52 ...
## ..- attr(*, "vars")=List of 3
## .. ..$ : symbol totaln
## .. ..$ : symbol xmonth
## .. ..$ : symbol nao
## ..- attr(*, "drop")= logi TRUE
## - attr(*, "indices")=List of 551
## ..$ : int 3403 3404 3405 3406 3407 3408 3816 3831 3879 3920 ...
## ..$ : int 3398 3399 3400 3401 3402
## ..$ : int 3412 3413 3414 3415 3416 3417 3914 3929 4134 4135 ...
## ..$ : int 3827 3828 3829 3830 3881 3963 3964 3965 3966 3983
## ..$ : int 3334 3759 3760 3780 3781 3782 3787 3788 3794 3795 ...
## ..$ : int 3348 3754 3755 3766 3767 3768 3785 3786 3820 3877
## ..$ : int 3778 3779 3783 3784 3791 3792 3793 3813 3814 3815 ...
## ..$ : int 3335 3336 3346 3347 3874 3875 3876 3878 3880
## ..$ : int 3409 3410 3411 3427 3428 3429 3430
## ..$ : int 2900 2901 2904 2905 2906 2907 2936 2937
## ..$ : int 2888 2889 2890 2891 2892 2893 2894 2895 2899 3951 ...
## ..$ : int 3977 3978
## ..$ : int 2838 2839 2840 2841 2842 2852 2853 2873 2898 2902 ...
## ..$ : int 2819 2820 2832 2833 2834 2835 2836 2837 2908 2909 ...
## ..$ : int 2823 2824 2825 2826 2876 2877 2880 2881 2882 2883 ...
## ..$ : int 3987 3988 4009 4129 4174
## ..$ : int 3900 3901 3902 3903 3904 3905 3906
## ..$ : int 2996 3018 3019 3020 3021 3022 3023 3854 3855 3857 ...
## ..$ : int 3087 3089 3090 3091 3092
## ..$ : int 3096 3097 3098 3099 3100 3102 3103 3104 3105 3106 ...
## ..$ : int 3138 3139 3140 3141 3142 3143 3832 3833 3835 3899
## ..$ : int 3028 3029 3030 3031 3032 3033 3062 3848 3849 3850
## ..$ : int 3063 3064 3065 3066 3073 3074 3075 3079 3080 3081 ...
## ..$ : int 3024 3025 3026 3027 3055 3056 3057 3058 3083 3084 ...
## ..$ : int 3059 3060 3061 3070 3071 3072 3076 3077 3078 3088 ...
## ..$ : int 3093 3124 3125 3126 3144 3145 3146 3147 3237 3345 ...
## ..$ : int 3907 3908 3909 3910 3911 3930 3931 3932 3933 3934 ...
## ..$ : int 2854 2855 2856 2857 2858 2859 2946 2947
## ..$ : int 3680 3683 3684
## ..$ : int 2948 2949 2950 2951 3957 3958 3959 3972
## ..$ : int 5673 5674 5680 5681 5682 5683
## ..$ : int 3821 3822 3823 3824 3825 3826 3967 3985
## ..$ : int 2926 2927 2928 3682 3953 3954 3955 3956 3969 3970
## ..$ : int 2930 3685 3686 3687 3694 3695 4091 4127
## ..$ : int 3986
## ..$ : int 4052 4074 4075 4076 4077
## ..$ : int 3042 3043 3044 3045 3046 3047 3048 3049 3069
## ..$ : int 3067 3068 3086
## ..$ : int 4036 4037
## ..$ : int 2963 2988 2989 2990 2991 2992 2993 2994 2995 3971 ...
## ..$ : int 3975 3976 4010 4023 4024
## ..$ : int 2939 2940 2941 2942 2943 2944 2945 2982 3950 3990
## ..$ : int 2956 2957 2958 2959 2960 2961 2962 2983
## ..$ : int 2984 2985 2986 2987 3001 3002 3003 3004 3005 3006
## ..$ : int 3128 3129 3130 3131 3132 3133 3134 3135 3688 3837 ...
## ..$ : int 3034 3035 3036 3037 3038 3039 3040 3041 3711 3712 ...
## ..$ : int 3852 3853 3937 3938 3939 3940 3960 3961
## ..$ : int 3165 3293 3294 3295 3296 3297 4045 4046 4047 4048
## ..$ : int 3179 3180 3181 3182 3183 3203 3222 3223 3224 3229 ...
## ..$ : int 3386 3387 3388 3389 3391 3392 3393 3394 3395
## ..$ : int 3315 3316 3317 3318 3319 3320 3321 3322 3609
## ..$ : int 3238 3239 3240 3241 3242 3243 3244 3360 3361 3521 ...
## ..$ : int 3362 3363 3364 3365 3366 3384 3385 3843 3844 3851 ...
## ..$ : int 3161 3162 3163 3164 3167 3175 3176 3177 3178 3184 ...
## ..$ : int 3189 3190 3191 3192 3193 3194 3195 3202 4011 4012
## ..$ : int 3566 3567 3568 3569 3570 3571 3572 3573
## ..$ : int 3185 3186 3187 3188 3196 3197 3198 3199 3200 3201 ...
## ..$ : int 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 ...
## ..$ : int 4004 4005 4006 4007 4008 4014
## ..$ : int 4042 4043 4044 4067 4068 4069 4070 4071 4072
## ..$ : int 4131 4172 4173 4275
## ..$ : int 4099 4100 4107 4108 4120 4121 4122 4123 4124 4133
## ..$ : int 4094 4095 4096 4097 4101 4102 4103 4104 4105 4106 ...
## ..$ : int 4199 4335 4336 4337 4835 4836 4837 4846 4847
## ..$ : int 4049 4050 4603 4604 4605 4624 4625 5203 5211 5212 ...
## ..$ : int 4112 4113 4114 4115 4116 4117 4118 4119 4125 4126 ...
## ..$ : int 4850 4851 4852 4853 4854 4855 4856 4857 4879
## ..$ : int 4715 4716 4717 4718 4719 4720 4721 4725 4726 5072
## ..$ : int 4690 4691 4692 4693 4694 4695 4696 4796 4800
## ..$ : int 4161 4162 4163 4164 4829 4830 4831 4832 5197 5198 ...
## ..$ : int 4026 4027 4028
## ..$ : int 1129 1130 4196 4197 4198
## ..$ : int 6878 6884 6885 6886
## ..$ : int 415 416 426 427 428
## ..$ : int 360 361 362 392 429 629 630 701 702 715 ...
## ..$ : int 76 77 78 79 85 151 1391 1537
## ..$ : int 1538 1539 4018 4019 4020 4021 4022 4289 4601 4602
## ..$ : int 3947 3948 3968 4015 4017 4033 4051 4175 4178 4179 ...
## ..$ : int 1147 1148 1149 1150 1151 4177
## ..$ : int 1105 1106 1107 1108 1109 1110 1111 1112 4013 4016
## ..$ : int 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066
## ..$ : int 1131 4029 4030 4031 4176 4181 4182
## ..$ : int 3979 3980 3981 3982 3989
## ..$ : int 2789 2790 2791 2792 2885 2886 2887 3597 3598
## ..$ : int 3799 3800 3801 3802 3803 3804 3811 3812
## ..$ : int 2829 2830 2831 2844 2845 2846 3923 3924 3925 4157 ...
## ..$ : int 3927 3928 4109 4110 4111 4132
## ..$ : int 2745 2746 2747 2748 2749 2750 2788 3915 3919 3962 ...
## ..$ : int 2763 2764 2765 2766 2767 2768 2769 3127 3158 3159 ...
## ..$ : int 2847 2848 2849 2850 2851 2869 2870 2871 2872 2896 ...
## ..$ : int 2724 2725 2739 2740 2741 2742 2743 2744 3599
## ..$ : int 2751 2752 2753 2756 2757
## ..$ : int 3668 3669 3670 3671 3672 3673 3674 3675 3676
## ..$ : int 3525 3526 3527 3528 3529 3530 3531 3533 3564 4000 ...
## ..$ : int 3349 3350 3351 3352 3353 3354 3355 3891 3892 3893 ...
## ..$ : int 3513 3514 3515 3516 3517 3518 3519 3520
## ..$ : int 3534 3535 3536 3537 3538 3539 3560 3561 3562 3563 ...
## ..$ : int 3418 3419 3420 3421 3422 3423 3424 3425 3426 3433 ...
## ..$ : int 3805 3806 3807 3808 3809 3810 3817 3818 3868 3869
## .. [list output truncated]
## - attr(*, "drop")= logi TRUE
## - attr(*, "group_sizes")= int 11 5 11 10 18 10 14 9 7 8 ...
## - attr(*, "biggest_group_size")= int 186
Zbiór danych po oczyszczaniu zmniejszył się do 6888 wierszy, liczba kolumn pozostała niezmieniona i wynosi 16. ## Analiza arybutów
knitr::kable(summary(w_duplicates))
| X | length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | fbar | recr | cumf | totaln | sst | sal | xmonth | nao | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Min. : 1.00 | Min. :19.00 | Min. : 0.00000 | Min. : 0.0000 | Min. : 0.000 | Min. : 5.238 | Min. : 0.3074 | Min. : 7.849 | Min. :0.0680 | Min. : 140515 | Min. :0.06833 | Min. : 144137 | Min. :12.77 | Min. :35.40 | 8 : 879 | Min. :-4.89000 | |
| 1st Qu.: 4.00 | 1st Qu.:24.00 | 1st Qu.: 0.02778 | 1st Qu.: 0.2500 | 1st Qu.: 2.469 | 1st Qu.:15.030 | 1st Qu.: 2.5479 | 1st Qu.:20.094 | 1st Qu.:0.1580 | 1st Qu.: 364794 | 1st Qu.:0.11008 | 1st Qu.: 307276 | 1st Qu.:13.64 | 1st Qu.:35.51 | 10 : 879 | 1st Qu.:-1.69000 | |
| Median : 7.00 | Median :25.50 | Median : 0.14158 | Median : 0.3714 | Median : 4.811 | Median :21.435 | Median : 5.9167 | Median :24.859 | Median :0.3320 | Median : 459347 | Median :0.21476 | Median : 539558 | Median :13.98 | Median :35.51 | 7 : 747 | Median : 0.20000 | |
| Mean : 15.72 | Mean :25.32 | Mean : 0.55913 | Mean : 1.7403 | Mean : 8.801 | Mean :21.157 | Mean : 11.3557 | Mean :27.683 | Mean :0.3202 | Mean : 543028 | Mean :0.21417 | Mean : 523418 | Mean :13.94 | Mean :35.52 | 9 : 680 | Mean : 0.08938 | |
| 3rd Qu.: 12.00 | 3rd Qu.:26.50 | 3rd Qu.: 0.36032 | 3rd Qu.: 1.5701 | 3rd Qu.: 9.667 | 3rd Qu.:26.324 | 3rd Qu.: 12.4959 | 3rd Qu.:35.153 | 3rd Qu.:0.4250 | 3rd Qu.: 774993 | 3rd Qu.:0.28116 | 3rd Qu.: 763083 | 3rd Qu.:14.21 | 3rd Qu.:35.52 | 6 : 559 | 3rd Qu.: 1.80000 | |
| Max. :186.00 | Max. :32.50 | Max. :37.66667 | Max. :19.3958 | Max. :75.000 | Max. :57.706 | Max. :115.5833 | Max. :68.736 | Max. :0.8490 | Max. :1565890 | Max. :0.39801 | Max. :1015595 | Max. :14.73 | Max. :35.61 | 5 : 521 | Max. : 5.08000 | |
| NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | (Other):2623 | NA |
data_dist <- w_duplicates %>%
select(-X) %>%
melt
ggplot(data_dist, aes(x= value)) +
geom_density(fill= "#2b8cbe") +
facet_wrap(~variable, scales= "free") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
Zmienne, poza length, nie mają rozkładu normalnego.
heatmaply(hetcor(as.data.frame(w_duplicates)), k_col = 2, k_row = 3)
Z powodu różnych klas kolumn, np. xmonth jest zmienną kategoryczną, length ciągłą a X porządkową. Została wyliczona heterogeniczna macierz korelacji, metodą hetcor z biblioteki ploycor.
p <- ggplot(w_duplicates, aes(x= X, y= length)) +
geom_line(alpha= 0.3) +
geom_smooth(method= "gam", formula= y ~ s(x, k= 100), size= 1) +
ggtitle("Zmiana rozmiaru złowionego śledzia w czasie")
ggplotly(p)
Jako, że dane zostały uporządkowane chronologicznie, długość śledzia w czasie prezentowany jest przy użyciu liczby porządkowej X. Z powodu ilości danych, który znacznie obniża czytelność wykresu, została zastosowana metoda smooth, która pozwoli na odkrycie ogólnego wzorca. Użycie wygładzenia liniowego, nie byłoby dostatecznie odpowiednie dla zebranego zestawu danych, dlatego został użyty uogólniony model addytywny gam.
Największa korelacja dotyczy par opisujących planktony, lcop1 i chel1 oraz lcop2 i chel2. Duży współczynnik korelacji pomiędzy cumf oraz totaln, przez co możemy wnioskować, iż wraz ze wzrostem łącznej liczby ryb złowionych w połowie rośnie natężenie połowów. Co więcej możemy zaobreswować korelację pomiędzy cumf oraz fbar - łączne roczne natężenie połowów było wysokie tak samo jak ich intensywność.
Regresor ma za zadanie przewidzieć rozmiary śledzia w kolejnych połowach. Dane zostały podzielone na dwa zbiory: uczący i testowy, z czego 75% całego zbioru zostało potraktowane jako uczące. Uczenie odbyło się przy użyciu metody Repeated Cross-Validation, z powodu niewielkich różnic wartości w zbiorze zastosowano liczbę powtórzeń na poziomie 5 z liczbą powtórzen 2. Model jest tworzony w opariu o model klasyfikacyjny Random Forrest.
fit <- lm(length ~ ., data = no_x)
# Miara R^2
summary(fit)$r.squared
## [1] 0.3315561
# Błąd średnio-kwadratowy
rmse <- function(num) sqrt(sum(num^2)/length(num))
rmse(fit$residuals)
## [1] 1.351338
inTraining <-
createDataPartition(
y = no_x$length,
p = 0.75,
list = FALSE)
training <- no_x[ inTraining,]
testing <- no_x[-inTraining,]
ctrl <- trainControl(
method = "repeatedcv",
number = 2,
repeats = 5)
fit <- train(length ~ .,
data = training,
method = "rf",
trControl = ctrl,
ntree = 2)
## Loading required package: randomForest
## randomForest 4.6-12
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
## The following object is masked from 'package:dplyr':
##
## combine
## The following object is masked from 'package:ggplot2':
##
## margin
fit
## Random Forest
##
## 39438 samples
## 14 predictor
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times)
## Summary of sample sizes: 19719, 19719, 19720, 19718, 19718, 19720, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared
## 2 1.179349 0.4903080
## 13 1.155392 0.5115404
## 24 1.157489 0.5099190
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 13.
plot(fit)
rfClasses <- predict(fit, newdata = testing)
summary(rfClasses)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 22.09 24.56 25.35 25.31 26.24 28.57
df<-data.frame(rfClasses)
ggplot(df, aes_string(x = rfClasses)) +
geom_histogram(bins= 100, fill= "#0087BD") +
ggtitle("Przewidywany rozmiar śledzia") +
theme_bw() +
labs(x= "Rozmiar śledzi", y="Liczba")
fit_rf <- randomForest(length ~ ., no_x)
fit_rf
##
## Call:
## randomForest(formula = length ~ ., data = no_x)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 4
##
## Mean of squared residuals: 1.319012
## % Var explained: 51.72
importance_df <- importance(fit_rf)
importance_df <- data.frame(var = rownames(importance_df), importance = importance_df[, 1])
importance_df$var <- factor(importance_df$var, levels = importance_df[order(importance_df$importance), "var"])
ggplot(importance_df, aes(x = var, y = importance)) +
geom_bar(stat = "identity", fill = "#2b8cbe") +
ggtitle("Ważność zmiennych") +
theme_bw()
ggplot(data, aes(x = length, y = sst)) +
geom_smooth() +
ggtitle("Zależność długości śledzia od temperatury przy powierzchni wody") +
theme_bw()
## `geom_smooth()` using method = 'gam'
Jak możemy zaobserwować na powyższym wykresie, długość śledzia maleje wraz ze wzrostem temperatury przy powierzchni wody.
ggplot(data, aes(X, sst)) +
geom_smooth() +
theme_bw() +
ggtitle("Zmiana temperatury wody w czasie") +
labs(x= "Czas - l.porzadkowa", y="Temperatura[°C]")
## `geom_smooth()` using method = 'gam'
Natomiast temperatura rosła przez ostatnie lata, co spowodowało znaczne obniżenie długości wyławianych śledzi.
ggplot(data, aes(X, nao)) +
geom_smooth() +
theme_bw() +
ggtitle("Zmiana Oscylacji Północnoatlantyckiej w czasie") +
labs(x= "Czas - l.porzadkowa", y="Oscylacja Północnoatlantycka")
## `geom_smooth()` using method = 'gam'
Konkludując powyższe informacje, możemy postawić diagnozę problemu - w ostatnich latach znacznie wzrosła temperatura przy powierzchni wody, co negatywnie wpłynęło na długość wyławianego śledzia. Wpływ na to ma również zmiana oscylacji północnoatlantyckiej - jest to zjawisko związane z globalną cyrkulacją powietrza i wody oceanicznej, ujawnia się poprzez fluktuacje takich parametrów, jak ciśnienie, temperatura, prędkość wiatru, ilość opadów.